(* ===================================================================== *)
(** Application bopipe : generation de testeur, blocs synchrones externes, 
    mode debug à partir de fichiers bpo.
    @author Mathieu Barbin
    @version 1.0.* *)
(* ===================================================================== *)

(* 
   BOPIPE produit une application a piper au simulateur (pipe01) qui permet :

   1) des tests unitaires sur circuits
   2) des interfaces avec des blocs synchrones externes
   3) un debuging graphique pas à pas. (biblioteques Bplib)

   TESTPIPE en cascade :
   Tous les outputs electriques (protocole pipe01) sont sur stdout. 
   Tous les autres outputs de l'executable produit sont sur stderr.
   Entre les balises FROM, l'utilisateur doit prevoir les affichages 
   en concequence.

   Dans le cas d'un test, on ecrit la chaine lue sur stdout (echo)
   pour pouvoir continuer eventuellement d'autres tests en cascade.
*)

open Bplib
open ListMap
open Message
open Inputtools
open Metatools

(* ===================================================================== *)
(** Lexer/Parser d'un fichier BPO : 
    return sext (source, macros, memoires, (lineInit, init), interface, (lineCode, code)) *)
(* ===================================================================== *)
let bpo_of_file filename =
  try
    let ic = open_in filename in
    let buff = Lexing.from_channel ic in
    let youpi = ParserBPO.input LexerBPO.lexem_list buff
    in
    begin
      close_in ic;
      youpi
    end
  with
  | Sys_error _ -> 
      message#bpo_file_introuvable filename;
      failwith "w-friendly"
  | Parsing.Parse_error ->
      message#syntax_error filename (!index_ligne_bpo_file); 
      failwith "w-friendly"
  | Failure m -> 
      message#syntax_error_message m filename (!index_ligne_bpo_file); 
      failwith "w-friendly";;
(* ===================================================================== *)

(* ===================================================================== *)
(* ===================================================================== *)
let ocaml_liaisons_string_args file method_name string_args_name_list args =
  let len = Array.length (Array.of_list string_args_name_list) in
  if len = 0 then ""
  else
    let first = 
      let rec aux accu = function
	| [] -> accu
	| [t] -> Printf.sprintf "%s%s =\n" accu t
	| t::q -> aux (Printf.sprintf "%s%s, " accu t) q
      in aux "  let " string_args_name_list 
    in
    let ligne_match_gauche =
      let rec aux accu i = 
	if i = len
	then (accu^"] -> ")
	else aux (Printf.sprintf "%s; v%d" accu i) (succ i)
      in aux (Printf.sprintf "    match %s with\n     | [ v0 " args) 1
    in
    let ligne_match_droit =
      let rec aux accu i =
	if i = len
	then accu^(Printf.sprintf "\n     | _ -> failwith \"%s, method %s : Protocole External01 Error\"\n  in\n" file method_name)
	else aux (Printf.sprintf "%s, v%d" accu i) (succ i)
      in aux "v0" 1
    in
    (first^ligne_match_gauche)^ligne_match_droit
(* ===================================================================== *)

(* ===================================================================== *)
(** Produire le code ocaml correspondant au .bpo *)
(* ===================================================================== *)
let programme_of_bpo_file filename oc =
  (* Garder un controle sur les numéros de ligne pour pouvoir gérer les 
     messages d'erreur d'ocamlopt pour rediriger sur la bonne ligne *)
  let index_meta_ligne = ref 1 in
  let produce_code c = 
    let new_line = num_line c in
    begin
      Printf.fprintf oc "%s" c;
      index_meta_ligne := (!index_meta_ligne) + new_line
    end
  in
  let (source, macros, memoires, (lineInit, init), bpo_object) = bpo_of_file filename in
  let debutInit = lineInit - (num_line init) in
  let env = env_macros_of_macros_BP filename macros in
  match (bp_source_of_string source) with
  | Ocaml ->
      begin
	prerr_endline "TARGET = ocaml";
	produce_code (Printf.sprintf "(* Programme ocaml macro-généré par bopipe %s : %s*)\n" Message.version (Message.get_date ()));
	produce_code "(* A compiler avec ocamlopt, puis appeler avec la primitive pipe ou un bloc external dans un .bop *)\n\n";
	produce_code "open BplibTypes;;\n";
	produce_code "open Bplib;;\n";
	produce_code "let args = Array.to_list Sys.argv;;\n";
	produce_code "let verbose = List.mem \"-v\" args;;\n";
(*	produce_code "let mute = List.mem \"-m\" args;;\n"; *)
	produce_code (Printf.sprintf "\n%s%s\n" stdlibBP (ocaml_macro filename macros));
	(
	  match memoires with
	  | [] -> ()
	  | _ ->
	      begin
		produce_code "open Graphics\n";
		let rec aux = function
		  | [] -> ()
		  | m::q ->
		      begin
			let name, typ_mem = 
			(match m.type_dcl_m with
			 | ROM_decl s  -> s, "rom"
			 | RAM_decl s -> s, "ram") in
			let string_arin = safe_string_of_expr env m.arite_entree_dcl_m
			and string_arout = safe_string_of_expr env m.arite_sortie_dcl_m in
			begin
			  produce_code (Printf.sprintf "let _%s = let tab_init =\n" name);
			  produce_code "let code_brut = ";
			  (
			    match m.description_entree_dcl_m with
			    | None -> produce_code "[||]";
			    | Some (Text t) -> produce_code 
				(Printf.sprintf "BoolArray.of_string \"%s\"" t)
			    | Some (File f) -> produce_code 
				(Printf.sprintf "BoolArray.of_asci_file \"%s\"" f)
		            | Some (BinaryFile f) -> produce_code
				(Printf.sprintf "BoolArray.of_bin_file \"%s\"" f)
			    | Some Counter -> produce_code "[||]";
			    | Some (UnitFun _) | Some (ArgFun _) -> produce_code "[||]";
			  );
			  produce_code (Printf.sprintf "\nin BoolMatrix.of_bool_array (2 $$ %s) %s code_brut\n" (string_arin) string_arout);
			  produce_code (Printf.sprintf "in new %s \"%s\" %s %s tab_init;;\n\n" typ_mem name string_arin string_arout);
			end; 
			aux q
		      end 
		in aux memoires
	      end
	);
	(* code de production des methodes *)
	let used_methods = ref StringSet.empty in
	let produce_method_code bpo_method = 
	  let (vars_in, argument_variable_name, argument_variable), (vars_out, user_self) =
	    (
	      match bpo_method.bpo_interface.bpo_input with
	      | BPOInputNetVars nvl -> (List.map (bp_var_of_var env) nvl), "", false
	      | BPOVarArg name -> [VWord (name, [||])], name, true 
	    ),
	    ( 
	      match bpo_method.bpo_interface.bpo_output with
	      | BPOOutputNetVars nvl -> (List.map (bp_var_of_var env) nvl), false
	      | UserSelf -> [], true
	    )
	  in 
	  let debutCode, code = 
	    match bpo_method.bpo_source with
	    | lineCode, cod -> ((lineCode - (num_line cod)), cod) in
	  begin
	    let args_todo = match bpo_method.bpo_string_args_name with
	      | Asked n -> n
	      | Optionnels _ -> [] 
	    in
	    (* Verifier la syntaxe pour compatibilité *)
	    verifie_ocaml_vars filename bpo_method.bpo_name ((VBit ("_"^bpo_method.bpo_name))::(vars_in@vars_out)@(List.map (fun n -> VBit n) args_todo));
	    (* produire le code *)
	    (* 1) verifier l'unicite des noms *)
	    if StringSet.mem bpo_method.bpo_name (!used_methods)
	    then (Message.message#definition_multiple_bpo_method filename bpo_method.bpo_interface.bpo_line bpo_method.bpo_name;
		  failwith "w-friendly")
	    else used_methods := StringSet.add bpo_method.bpo_name (!used_methods);
	    (* 2) produire la fonction ocaml qui corresponde *)
	    produce_code (Printf.sprintf "let _%s args _META_line =\nbegin\n" bpo_method.bpo_name);
	    (* liaisons entre les noms des arguments string et des arguments donnes (eventuellement erreur) *)
	    produce_code (ocaml_liaisons_string_args filename bpo_method.bpo_name args_todo "args");
	    if argument_variable 
	    then 
	      begin
		produce_code (Printf.sprintf "  let %s = Array.init (String.length _META_line) (fun t -> _META_line.[t] = '1') in\n" argument_variable_name)
	      end
	    else produce_code (ocaml_entete_of_interface true false filename vars_in vars_out); 
	    (*
	      produce_code "    if verbose\n";  
	      produce_code "    then\n";
	      produce_code (Printf.sprintf "      begin\n%sprerr_newline ();\n      end\n" (ocaml_traitement_stderr vars_in));
	      produce_code "    else ();\n";
	    *)
	    produce_code "    begin\n";
	    produce_code "    try\n";
	    produce_code "      begin\n";
	    produce_code (Printf.sprintf "(* FROM %s [%d] : CODE (%d - %d) *)\n" (String.uppercase filename) debutCode (!index_meta_ligne + 2) (!index_meta_ligne + 2 + (num_line code)));
	    produce_code (Printf.sprintf "# %d \"%s\"\n" debutCode filename);
	    produce_code (Printf.sprintf "%s\n(* END FROM CODE *)\n" code);
	    produce_code "      end;\n"; 
	    produce_code (Printf.sprintf "# %d \"_tmp.ml\"\n" (!index_meta_ligne + 1));
	    (*
	    produce_code (Printf.sprintf "      if verbose\n      then prerr_endline (Printf.sprintf \"TEST Cycle %cd : OK\" (!index_cycle))\n      else ();\n" '%');
	    *)
	    produce_code "\n(* Vers stdout selon le protocole pipe 01 *)\n";
	    if user_self 
	    then ()
	    else
	      begin
		produce_code (ocaml_traitement_stdout vars_out);
		produce_code "\nprint_newline (); flush stdout;\n"
	      end;
	    produce_code "    with\n"; 
	    produce_code "      | TEST_FAILURE (stop, err) -> \n";
	    produce_code (Printf.sprintf "          Printf.fprintf stderr \"CYCLE %cd : \\\"%cs\\\"  \\n\" (!index_cycle) err;\n" '%' '%');
	    produce_code (Printf.sprintf "          prerr_endline \"BOPIPE TEST_FAILURE FROM %s \";\n" filename);
	    produce_code "          if stop then failwith \"BREAK\" else ()\n"; 
	    produce_code "  end\n";
	    produce_code (Printf.sprintf "end ;; (* of method _%s *)\n\n" bpo_method.bpo_name)
	  end
	in
	produce_code "let index_cycle = ref 0;;\n";
	produce_code (Printf.sprintf "(* FROM %s [%d] : INIT (%d - %d) *)\n" (String.uppercase filename) debutInit (!index_meta_ligne + 2) (!index_meta_ligne + 2 + (num_line init)));
	produce_code (Printf.sprintf "# %d \"%s\"\n" debutInit filename);
	produce_code (Printf.sprintf "%s\n(* END FROM INIT *)let end_init = true;;\n" init);
	produce_code (Printf.sprintf "# %d \"_tmp.ml\"\n" (!index_meta_ligne + 1));

	(* production du code des methodes et du main *)

	List.iter (fun m -> produce_method_code m) bpo_object.bpo_methods;
	produce_method_code bpo_object.bpo_main;

	(* production des fonctions d'aiguillage *)
	produce_code "let __aiguillage s =\n";
	produce_code "  incr(index_cycle);\n";
	produce_code "  let com, args, prot = \n";
	produce_code "    let ssp = split_protocole s in\n";
	produce_code "    ssp.externalCommande, ssp.externalArguments, ssp.externalBits\n";
	produce_code "  in\n";
	produce_code "  match com with\n";
	List.iter (fun m -> produce_code (Printf.sprintf "   | \"%s\" -> _%s args prot\n" m.bpo_name m.bpo_name)) bpo_object.bpo_methods;
	produce_code (Printf.sprintf "   | \"\" -> _%s args prot\n" bpo_object.bpo_main.bpo_name);
	produce_code (Printf.sprintf "   | t ->\n");
        produce_code                 "      begin\n";
        produce_code (Printf.sprintf "        Printf.fprintf stderr \" %sx, Methode inconnue \\\"%cs\\\"\\%c\" t; flush stderr;\n" filename '%' 'n');
        produce_code                 "        exit 0\n";
        produce_code                 "      end\n";
	produce_code ";;\n";

	produce_code "let _ =\n"; 
	produce_code (Printf.sprintf "  prerr_endline \"This is \\\"%s\\\" by bopipe %s\";\n" filename version);
	produce_code "  while true do\n";
	produce_code "    let _GET_line = input_line stdin in\n";
	produce_code (Printf.sprintf "    __aiguillage _GET_line\n");
	produce_code "  done;;\n";
    end 
  | C -> 
      begin
	failwith "TODO bopipe in C --> bebop1.1 ?"
      end
  | Autre lg ->
      begin
	Message.message#autre_langage "bopipe" lg;
	failwith "w-friendly"
      end
  | Inconnu lg -> 
      begin
	Message.message#langage_inconnu "bopipe" lg;
	failwith "w-friendly"
      end
(* ===================================================================== *)


let _ =
  let len = Array.length Sys.argv in
  Message.message#thisis "bopipe";
  if len < 2
  then
    begin
      Printf.fprintf stderr "use : %s myfile.bpo > result.ml\n" Sys.argv.(0);
      exit(1)
    end
  else programme_of_bpo_file Sys.argv.(1) stdout


